<%
'-----------------
'自定义函数
'-----------------

'高亮显示内容关键词
Function keyword_highlight(ByVal content, ByVal keyword)
	keyword = Trim(keyword)
	If keyword<>"" Then content = AB.C.RP(content, keyword, "<font color=red><strong>"& keyword & "</strong></font>")
	keyword_highlight = content
End Function

'获取相关文章
Function get_relate_list(ByVal id, ByVal count)
	Dim t,keywords,tags,key,arrKey,a_where,s_where,list : arrKey = Array() : a_where = Array()
	Dim group, module_name, module_id : group = LCase(GROUP_NAME) : module_name = group
	If group="news" Then module_name="article" '新闻频道 对应 article表
	module_id = M("modules")().Where("name='"& module_name &"'").getField("id")
	count = IntVal(count)
	id = IntVal(id)
	If module_id>0 And id>0 Then
		AB.Use "A"
		keywords = M(module_name)().Find(id).getField("seo_keys")
		tags = M("tag")().Where( Array("module_id="& module_id, "arcid="& id) ).getField("name:1") '后面加:1表示返回数组(多个纪录)
		If IsArray(tags) Then tags = Join(tags,",")
		If tags<>"" Then
			For Each key In Split(tags,",")
				If Trim(key)<>"" Then arrKey = AB.A.Push(arrKey, Trim(key))
			Next
		End If
		If keywords<>"" Then
			For Each key In Split(keywords,",")
				If Trim(key)<>"" Then arrKey = AB.A.Push(arrKey, Trim(key))
			Next
		End If
		arrKey = AB.A.Unique(arrKey) '移除重复元素
		For Each key In arrKey
			If Trim(key)<>"" Then
				t = "([title] LIKE '%"& key &"%' OR [seo_keys] LIKE '%"& key &"%')"
				a_where = AB.A.Push(a_where, t)
			End If
		Next
		If Not AB.C.isNul(a_where) Then
			s_where = "1=1 AND id<>"& id
			s_where = s_where & " AND ( "& Join(a_where," OR ") & " )"
			Set list = M(module_name)().Where(s_where).Limit(0,count).Fetch()
		End If
	End If
	If AB.C.IsNul(list) Then Set list = AB.C.NewRs()
	Set get_relate_list = list
End Function

'阅读量显示js
Function show_hits(ByVal id)
	link = U(GROUP_NAME&":api/show_hits?id=" & IntVal(id))
	show_hits = "<script type=""text/javascript"" src="""& link &"""></script>"
End Function

'获取文档url链接
Function getArcUrl(ByVal id)
	getArcUrl = U(GROUP_NAME&":index/show?id=" & IntVal(id))
End Function

'获取当前栏目URL
Function catUrl(ByVal id)
	catUrl = U(GROUP_NAME&":index/category?id=" & IntVal(id))
End Function

'获取当前栏目名称
Function catName(ByVal id)
	catName = M("class")().Find(id).getField("name")
End Function

'获取当前栏目链接
Function catLink(ByVal id)
	Dim url, name : url = catUrl(id) : name = catName(id)
	catLink = "<a href="""& url &""" title="""& name &""">" & name & "</a>"
End Function

'当前位置 (面包屑导航)
Function NavPos(ByVal id, ByVal separator)
	Dim pids,link,title,arr : id = IntVal(id) : arr = Array()
	Dim group, module_id, topid : topid = 0
	If id>0 Then
		group = LCase(GROUP_NAME)
		module_id = get_module_id() '当前模型id
		If AB.C.IsNul(module_id) Then module_id = M("class")().Find(id).getField("module_id")
		topid = M("class")().Where("typeid=0 and module_id="& module_id &" and pid=0").getField("id")
		pids = parent_ids(id,true)
		If Not AB.C.IsNul(pids) Then
			AB.Use "A"
			For Each i In Split(pids,",")
				If CLng(i)<>topid Then
					link = U(group&":index/category?id="&i)
					title = M("class")().Find(i).getField("name")
					If title<>"" Then arr = AB.A.Push(arr, "<a href="""& link &""">"& title &"</a>")
				End If
			Next
		End If
	End If
	NavPos = Join(arr, separator)
End Function

'获取当前模型ID
Function get_module_id()
	get_module_id = getModuleData()(0)
End Function

'获取当前模型名称(数据表名)
Function get_module_name()
	get_module_name = getModuleData()(1)
End Function

'当前模型数据
Function getModuleData()
	Dim group, module_id, module_name
	group = LCase(GROUP_NAME)
	module_name = group
	If group="news" Then module_name="article" '新闻频道 对应 article表
	module_id = M("modules")().Where("name='"& module_name &"'").getField("id")
	getModuleData = Array(module_id, module_name)
End Function

Function get_index()
	Dim list : Set list = AB.C.Dict()
	list("9") = "0~9"
	For i=65 To 90
		list(chr(i)& "") = chr(i)
	Next
	Set get_index = list
End Function

'e.g. html_select("index",get_index(),null)
Function html_select(ByVal name, ByVal list, ByVal id)
	Dim i, str : If AB.C.IsNul(id) Then id = -1
    str = str & "<select name='"& name &"' id='"& name &"'>"
    str = str & "<option value='-1'>请选择...</option>"
	For Each i In list
		str = str & "<option value='"& i &"'"
		If Cstr(i) = Cstr(id) Then
			str = str & " selected='selected'"
		End If
		str = str & ">"& list(i) &"</option>"
	Next
	str = str & "</select>"
	html_select = str
End Function

Function get_child_ids(ByVal model, ByVal id)
	Dim ids, rs, a, str : AB.Use "A"
	Set rs = model.Dao.Where("pid="& IntVal(id)).Fetch()
	If rs.RecordCount>0 Then
		Do While Not rs.Eof
			ids = ids & "," & rs("id")
			ids = ids & "," & get_child_ids(model, rs("id"))
			rs.MoveNext
		Loop
		str = ids
	Else
		str = ""
	End If
	rs.Close() : Set rs = Nothing
	a = AB.A.Fetch(str, ",")
	str = Join(a, ",")
	get_child_ids = str
End Function

Function get_child_data(ByVal model, ByVal pid, ByVal depth)
	Dim rs, fields, f, d, dd : AB.Use "A"
	If AB.C.IsNul(depth) Then depth = 0
	Set d = AB.C.Dict()
	Set rs = model.Dao.Where("pid="& IntVal(pid)).Fetch()
	If rs.RecordCount>0 Then
		depth = depth+1
		fields = model.Dao.RsFields(rs)
		Do While Not rs.Eof
			Set dd = AB.C.Dict()
			For Each f In fields
				dd(f) = rs(f).Value
			Next
			dd("depth") = depth
			Set dd("child") = get_child_data(model, rs("id").Value, depth)
			d.Add rs("id").Value, dd
			rs.MoveNext
		Loop
	End If
	rs.Close() : Set rs = Nothing
	Set get_child_data = d
End Function

Function get_cate_data(ByVal model, ByVal id)
	Dim rs, fields, f, d, dd : AB.Use "A"
	Dim where : id = IntVal(id)
	If id>0 Then where = "id="& id Else where = "pid=0"
	Set d = AB.C.Dict()
	Set rs = model.Dao.Where(where).Fetch()
	If rs.RecordCount>0 Then
		fields = model.Dao.RsFields(rs)
		Do While Not rs.Eof
			Set dd = AB.C.Dict()
			For Each f In fields
				dd(f) = rs(f).Value
			Next
			dd("depth") = 0
			Set dd("child") = get_child_data(model, rs("id").Value, 0)
			d.Add rs("id").Value, dd
			rs.MoveNext
		Loop
	End If
	rs.Close() : Set rs = Nothing
	Set get_cate_data = d
End Function

Function get_cate_tree(ByVal list, ByVal checked_ids)
	Dim i, margin_left, str : str = ""
	If Not IsArray(checked_ids) Then checked_ids = Array()
	For Each i In list
		margin_left = IntVal(list(i)("depth")) * 20
		str = str & "<div class='checkbox_items' style='margin-left:"& margin_left &"px;'><input type='checkbox'"
		If AB.A.InArray(list(i)("id"), checked_ids) Then
			str = str & " checked='checked' "
		End If
		str = str & " name='cate_id' value='"& list(i)("id") &"'/>&nbsp;&nbsp;"& list(i)("name") &"</div>"
		str = str & get_cate_tree(list(i)("child"), checked_ids)
	Next
	get_cate_tree = str
End Function

'过滤HTML标记
Function CText(ByVal s)
	CText = AB.C.HtmlFilter(s)
End Function

Function is_url(ByVal s)
	is_url = False
	If AB.C.RegTest(s, "^(http|https|ftp|mms|rtsp)://") Then is_url = True
End Function

'获取附件地址
Function attach(ByVal fname, ByVal stype)
	Dim is_local, attach_file
	If is_url(fname) Then
		attach = fname
		Exit Function
	End If
	is_local = (Instr(fname,App.UploadPath())>0)
	If is_local Then attach_file = fname Else attach_file = App.UploadPath() & stype & "/" & fname
	If Not AB.C.IsFile(attach_file) Then attach_file = App.UploadPath() & "no_picture.gif"
	attach = attach_file
End Function

'获取用户头像地址
Function avatar(ByVal uid, ByVal size)
	On Error Resume Next
	Dim avatar_dir, avatar_file, str, ext : uid = IntVal(uid)
	If M("user")().Find(uid).Count()>0 Then 'check user exists
		str = M("user")().Find(uid).getField("avatar")
		If str<>"" Then
			avatar_file = str
			avatar_dir = avatarDir(uid)
			If Not Instr(str,"/")>0 Then avatar_file = avatar_dir & avatar_file
			If IntVal(size)>0 Then
				AB.Use "Fso"
				ext = AB.Fso.ExtOf(avatar_file)
				avatar_file = Left(avatar_file,Len(avatar_file)-Len(ext)) & "_"& size & ext
			End If
		End If
	End If
	avatar = avatar_file
	On Error Goto 0
End Function

'获取用户头像上传目录
Function avatarDir(ByVal uid)
	AB.Use "E" : AB.E.Use "md5"
	avatarDir = App.UploadPath() & "avatar/" & AB.E.md5.To16(uid) & "/"
End Function

'获取模型名称
Function moduleName(ByVal id)
	If Not AB.C.IsNul(id) Then moduleName = M("modules")().Find(id).getField("title")
End Function

'读取“站点设置”信息
Function siteCfg(ByVal p)
	On Error Resume Next
	If IsObject(ReadCfg(p,"setting")) Then Set siteCfg=ReadCfg(p,"setting") Else siteCfg=ReadCfg(p,"setting")
	On Error Goto 0
End Function

'读取“SEO设置”信息
Function seoCfg(ByVal p)
	On Error Resume Next
	If IsObject(ReadCfg(p,"seo")) Then Set seoCfg=ReadCfg(p,"seo") Else seoCfg=ReadCfg(p,"seo")
	On Error Goto 0
End Function

Function ReadCfg(ByVal p, ByVal tbl)
	On Error Resume Next
	Dim rs, f, k, val, jsLib, jso, j : f = Trim(p)
	If InStr(f,".")>0 Then
		k = AB.C.CRight(f,".")
		f = Split(f,".")(0)
	End If
	Set rs = M(tbl)().Field("data").Where("name='"& f &"'").Fetch()
	If Not (rs.Bof And rs.Eof) Then
		val = rs("data").Value
		If AB.C.RegTest(val,"^\{.+\}") Then 'json字串
			AB.Use "json"
			Set val = AB.Json.toObject(val)
		' ElseIf AB.C.RegTest(val,"^a\:\d+\:\{") Then 'serialize字串
			' val = AB.C.RP(val,"\""","""")
			' If IsObject(unserialize(val)) Then Set val = unserialize(val)
		End If
		If Err.Number<>0 Then
			val = Empty
			If k="" Then val = rs("data").Value
		End If
		Err.Clear
		If IsObject(val) And k<>"" Then
			If IsObject(Eval("val."&k)) Then Set val=Eval("val."&k) Else val=Eval("val."&k)
			If Err.Number<>0 Then
				val = Empty
				Err.Clear
			End If
		End If
	End If
	rs.Close() : Set rs = Nothing
	If IsObject(val) Then Set ReadCfg=val Else ReadCfg=val
	On Error Goto 0
End Function

'刷新SiteCfg数据
Sub SiteCfgDataRefresh()
	Dim sskey : sskey = "global_site_cfg"
	AB.C.SetApp sskey, Empty
	Dim data : Set data = SiteCfgData()
End Sub

'获取并缓存SiteCfg数据
Function SiteCfgData()
	Dim cfgData, rsset, f, v, d, Matches, Match, var, sskey : sskey = "global_site_cfg"
	If AB.C.IsNul(AB.C.GetApp(sskey)) Then
		Set cfgData = AB.C.Dict()
		Set rsset = M("setting")().Fetch()
		Do While Not rsset.Eof
			f = rsset("name").Value
			v = rsset("data").Value
			v = AB.C.RP(v, Array("\\","\{","\}"), Array(Chr(7),Chr(8),Chr(9)))
			If AB.C.RegTest(v,"\{\w+\}") Then
				Set Matches = AB.C.RegMatch(v, "\{(\w+)\}")
				For Each Match In Matches
					var = Trim(Match.SubMatches(0))
					If M("setting")().Where("name='"&var&"'").Count()>0 Then
						If Not IsObject(siteCfg(var)) Then
							v = AB.C.RP( v, Match.Value, siteCfg(var) )
						End If
					End If
				Next
				Set Matches = Nothing
			End If
			v = AB.C.RP(v, Array(Chr(9),Chr(8),Chr(7)), Array("}","{","\"))
			d = v
			If AB.C.RegTest(v,"^\{.+\}$") Then 'json字串
				AB.Use "json"
				Set v = AB.Json.toObject(v)
			End If
			If Err.Number<>0 Then
				v = Empty
				v = d
			End If
			If IsObject(v) Then Set cfgData(f)=v Else cfgData(f)=v
			rsset.MoveNext
		Loop
		AB.C.SetApp sskey, Array(cfgData)
	End If
	Set SiteCfgData = AB.C.GetApp(sskey)(0)
End Function

'刷新SeoCfg数据
Sub SeoCfgDataRefresh()
	Dim sskey : sskey = "global_seo_cfg"
	AB.C.SetApp sskey, Empty
	Dim data : Set data = SeoCfgData()
End Sub

Function SeoCfgData()
	Dim cfgData, rsset, f, v, d, Matches, Match, var, sskey : sskey = "global_seo_cfg"
	If AB.C.IsNul(AB.C.GetApp(sskey)) Then
		Set cfgData = AB.C.Dict()
		Set rsset = M("seo")().Fetch()
		Do While Not rsset.Eof
			f = rsset("name").Value
			v = rsset("data").Value
			v = AB.C.RP(v, Array("\\","\{","\}"), Array(Chr(7),Chr(8),Chr(9)))
			If AB.C.RegTest(v,"\{\w+\}") Then
				Set Matches = AB.C.RegMatch(v, "\{(\w+)\}")
				For Each Match In Matches
					var = Trim(Match.SubMatches(0))
					If M("seo")().Where("name='"&var&"'").Count()>0 Then
						If Not IsObject(seoCfg(var)) Then
							v = AB.C.RP( v, Match.Value, seoCfg(var) )
						End If
					End If
				Next
				Set Matches = Nothing
			End If
			If AB.C.RegTest(v,"\{\w+\}") Then
				Set Matches = AB.C.RegMatch(v, "\{(\w+)\}")
				For Each Match In Matches
					var = Trim(Match.SubMatches(0))
					If M("setting")().Where("name='"&var&"'").Count()>0 Then
						If Not IsObject(siteCfg(var)) Then
							v = AB.C.RP( v, Match.Value, siteCfg(var) )
						End If
					End If
				Next
				Set Matches = Nothing
			End If
			v = AB.C.RP(v, Array(Chr(9),Chr(8),Chr(7)), Array("}","{","\"))
			cfgData(f) = v
			rsset.MoveNext
		Loop
		AB.C.SetApp sskey, Array(cfgData)
	End If
	Set SeoCfgData = AB.C.GetApp(sskey)(0)
End Function
%>